home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / gnus-demon.el.z / gnus-demon.el
Encoding:
Text File  |  1998-05-21  |  10.5 KB  |  309 lines
  1. ;;; gnus-demon.el --- daemonic Gnus behaviour
  2. ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  5. ;; Keywords: news
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;;; Code:
  27.  
  28. (eval-when-compile (require 'cl))
  29.  
  30. (require 'gnus)
  31. (require 'gnus-int)
  32. (require 'nnheader)
  33. (eval-and-compile
  34.   (if (string-match "XEmacs" (emacs-version))
  35.       (require 'itimer)
  36.     (require 'timer)))
  37.  
  38. (defgroup gnus-demon nil
  39.   "Demonic behaviour."
  40.   :group 'gnus)
  41.  
  42. (defcustom gnus-demon-handlers nil
  43.   "Alist of daemonic handlers to be run at intervals.
  44. Each handler is a list on the form
  45.  
  46. \(FUNCTION TIME IDLE)
  47.  
  48. FUNCTION is the function to be called.
  49. TIME is the number of `gnus-demon-timestep's between each call.
  50. If nil, never call.  If t, call each `gnus-demon-timestep'.
  51. If IDLE is t, only call if Emacs has been idle for a while.  If IDLE
  52. is a number, only call when Emacs has been idle more than this number
  53. of `gnus-demon-timestep's.  If IDLE is nil, don't care about
  54. idleness.  If IDLE is a number and TIME is nil, then call once each
  55. time Emacs has been idle for IDLE `gnus-demon-timestep's."
  56.   :group 'gnus-demon
  57.   :type '(repeat (list function
  58.                (choice :tag "Time"
  59.                    (const :tag "never" nil)
  60.                    (const :tag "one" t)
  61.                    (integer :tag "steps" 1))
  62.                (choice :tag "Idle"
  63.                    (const :tag "don't care" nil)
  64.                    (const :tag "for a while" t)
  65.                    (integer :tag "steps" 1)))))
  66.  
  67. (defcustom gnus-demon-timestep 60
  68.   "*Number of seconds in each demon timestep."
  69.   :group 'gnus-demon
  70.   :type 'integer)
  71.  
  72. ;;; Internal variables.
  73.  
  74. (defvar gnus-demon-timer nil)
  75. (defvar gnus-demon-idle-has-been-called nil)
  76. (defvar gnus-demon-idle-time 0)
  77. (defvar gnus-demon-handler-state nil)
  78. (defvar gnus-demon-last-keys nil)
  79. (defvar gnus-inhibit-demon nil
  80.   "*If non-nil, no daemonic function will be run.")
  81.  
  82. (eval-and-compile
  83.   (autoload 'timezone-parse-date "timezone")
  84.   (autoload 'timezone-make-arpa-date "timezone"))
  85.  
  86. ;;; Functions.
  87.  
  88. (defun gnus-demon-add-handler (function time idle)
  89.   "Add the handler FUNCTION to be run at TIME and IDLE."
  90.   ;; First remove any old handlers that use this function.
  91.   (gnus-demon-remove-handler function)
  92.   ;; Then add the new one.
  93.   (push (list function time idle) gnus-demon-handlers)
  94.   (gnus-demon-init))
  95.  
  96. (defun gnus-demon-remove-handler (function &optional no-init)
  97.   "Remove the handler FUNCTION from the list of handlers."
  98.   (setq gnus-demon-handlers
  99.     (delq (assq function gnus-demon-handlers)
  100.           gnus-demon-handlers))
  101.   (unless no-init
  102.     (gnus-demon-init)))
  103.  
  104. (defun gnus-demon-init ()
  105.   "Initialize the Gnus daemon."
  106.   (interactive)
  107.   (gnus-demon-cancel)
  108.   (if (null gnus-demon-handlers)
  109.       ()                ; Nothing to do.
  110.     ;; Set up timer.
  111.     (setq gnus-demon-timer
  112.       (nnheader-run-at-time
  113.        gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
  114.     ;; Reset control variables.
  115.     (setq gnus-demon-handler-state
  116.       (mapcar
  117.        (lambda (handler)
  118.          (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
  119.            (nth 2 handler)))
  120.        gnus-demon-handlers))
  121.     (setq gnus-demon-idle-time 0)
  122.     (setq gnus-demon-idle-has-been-called nil)
  123.     (setq gnus-use-demon t)))
  124.  
  125. (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
  126.  
  127. (defun gnus-demon-cancel ()
  128.   "Cancel any Gnus daemons."
  129.   (interactive)
  130.   (when gnus-demon-timer
  131.     (nnheader-cancel-timer gnus-demon-timer))
  132.   (setq gnus-demon-timer nil
  133.     gnus-use-demon nil)
  134.   (condition-case ()
  135.       (nnheader-cancel-function-timers 'gnus-demon)
  136.     (error t)))
  137.  
  138. (defun gnus-demon-is-idle-p ()
  139.   "Whether Emacs is idle or not."
  140.   ;; We do this simply by comparing the 100 most recent keystrokes
  141.   ;; with the ones we had last time.  If they are the same, one might
  142.   ;; guess that Emacs is indeed idle.  This only makes sense if one
  143.   ;; calls this function seldom -- like once a minute, which is what
  144.   ;; we do here.
  145.   (let ((keys (recent-keys)))
  146.     (or (equal keys gnus-demon-last-keys)
  147.     (progn
  148.       (setq gnus-demon-last-keys keys)
  149.       nil))))
  150.  
  151. (defun gnus-demon-time-to-step (time)
  152.   "Find out how many seconds to TIME, which is on the form \"17:43\"."
  153.   (if (not (stringp time))
  154.       time
  155.     (let* ((now (current-time))
  156.            ;; obtain NOW as discrete components -- make a vector for speed
  157.            (nowParts (apply 'vector (decode-time now)))
  158.            ;; obtain THEN as discrete components
  159.            (thenParts (timezone-parse-time time))
  160.            (thenHour (string-to-int (elt thenParts 0)))
  161.            (thenMin (string-to-int (elt thenParts 1)))
  162.            ;; convert time as elements into number of seconds since EPOCH.
  163.            (then (encode-time 0
  164.                               thenMin
  165.                               thenHour
  166.                               ;; If THEN is earlier than NOW, make it
  167.                               ;; same time tomorrow. Doc for encode-time
  168.                               ;; says that this is OK.
  169.                               (+ (elt nowParts 3)
  170.                                  (if (or (< thenHour (elt nowParts 2))
  171.                                          (and (= thenHour (elt nowParts 2))
  172.                                               (<= thenMin (elt nowParts 1))))
  173.                                      1 0))
  174.                               (elt nowParts 4)
  175.                               (elt nowParts 5)
  176.                               (elt nowParts 6)
  177.                               (elt nowParts 7)
  178.                               (elt nowParts 8)))
  179.            ;; calculate number of seconds between NOW and THEN
  180.            (diff (+ (* 65536 (- (car then) (car now)))
  181.                     (- (cadr then) (cadr now)))))
  182.       ;; return number of timesteps in the number of seconds
  183.       (round (/ diff gnus-demon-timestep)))))
  184.  
  185. (defun gnus-demon ()
  186.   "The Gnus daemon that takes care of running all Gnus handlers."
  187.   ;; Increase or reset the time Emacs has been idle.
  188.   (if (gnus-demon-is-idle-p)
  189.       (incf gnus-demon-idle-time)
  190.     (setq gnus-demon-idle-time 0)
  191.     (setq gnus-demon-idle-has-been-called nil))
  192.   ;; Disable all daemonic stuff if we're in the minibuffer
  193.   (when (and (not (window-minibuffer-p (selected-window)))
  194.          (not gnus-inhibit-demon))
  195.     ;; Then we go through all the handler and call those that are
  196.     ;; sufficiently ripe.
  197.     (let ((handlers gnus-demon-handler-state)
  198.       (gnus-inhibit-demon t)
  199.       handler time idle)
  200.       (while handlers
  201.     (setq handler (pop handlers))
  202.     (cond
  203.      ((numberp (setq time (nth 1 handler)))
  204.       ;; These handlers use a regular timeout mechanism.  We decrease
  205.       ;; the timer if it hasn't reached zero yet.
  206.       (unless (zerop time)
  207.         (setcar (nthcdr 1 handler) (decf time)))
  208.       (and (zerop time)        ; If the timer now is zero...
  209.            ;; Test for appropriate idleness
  210.            (progn
  211.          (setq idle (nth 2 handler))
  212.          (cond
  213.           ((null idle) t)    ; Don't care about idle.
  214.           ((numberp idle)    ; Numerical idle...
  215.            (< idle gnus-demon-idle-time)) ; Idle timed out.
  216.           (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
  217.            ;; So we call the handler.
  218.            (progn
  219.          (ignore-errors (funcall (car handler)))
  220.          ;; And reset the timer.
  221.          (setcar (nthcdr 1 handler)
  222.              (gnus-demon-time-to-step
  223.               (nth 1 (assq (car handler) gnus-demon-handlers)))))))
  224.      ;; These are only supposed to be called when Emacs is idle.
  225.      ((null (setq idle (nth 2 handler)))
  226.       ;; We do nothing.
  227.       )
  228.      ((and (not (numberp idle))
  229.            (gnus-demon-is-idle-p))
  230.       ;; We want to call this handler each and every time that
  231.       ;; Emacs is idle.
  232.       (ignore-errors (funcall (car handler))))
  233.      (t
  234.       ;; We want to call this handler only if Emacs has been idle
  235.       ;; for a specified number of timesteps.
  236.       (and (not (memq (car handler) gnus-demon-idle-has-been-called))
  237.            (< idle gnus-demon-idle-time)
  238.            (gnus-demon-is-idle-p)
  239.            (progn
  240.          (ignore-errors (funcall (car handler)))
  241.          ;; Make sure the handler won't be called once more in
  242.          ;; this idle-cycle.
  243.          (push (car handler) gnus-demon-idle-has-been-called)))))))))
  244.  
  245. (defun gnus-demon-add-nocem ()
  246.   "Add daemonic NoCeM handling to Gnus."
  247.   (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
  248.  
  249. (defun gnus-demon-scan-nocem ()
  250.   "Scan NoCeM groups for NoCeM messages."
  251.   (save-window-excursion
  252.     (gnus-nocem-scan-groups)))
  253.  
  254. (defun gnus-demon-add-disconnection ()
  255.   "Add daemonic server disconnection to Gnus."
  256.   (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
  257.  
  258. (defun gnus-demon-close-connections ()
  259.   (save-window-excursion
  260.     (gnus-close-backends)))
  261.  
  262. (defun gnus-demon-add-scanmail ()
  263.   "Add daemonic scanning of mail from the mail backends."
  264.   (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
  265.  
  266. (defun gnus-demon-scan-mail ()
  267.   (save-window-excursion
  268.     (let ((servers gnus-opened-servers)
  269.       server)
  270.       (while (setq server (car (pop servers)))
  271.     (and (gnus-check-backend-function 'request-scan (car server))
  272.          (or (gnus-server-opened server)
  273.          (gnus-open-server server))
  274.          (gnus-request-scan nil server))))))
  275.  
  276. (defun gnus-demon-add-rescan ()
  277.   "Add daemonic scanning of new articles from all backends."
  278.   (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
  279.  
  280. (defun gnus-demon-scan-news ()
  281.   (save-window-excursion
  282.     (when (gnus-alive-p)
  283.       (save-excursion
  284.     (set-buffer gnus-group-buffer)
  285.     (gnus-group-get-new-news)))))
  286.  
  287. (defun gnus-demon-add-scan-timestamps ()
  288.   "Add daemonic updating of timestamps in empty newgroups."
  289.   (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
  290.  
  291. (defun gnus-demon-scan-timestamps ()
  292.   "Set the timestamp on all newsgroups with no unread and no ticked articles."
  293.   (when (gnus-alive-p)
  294.     (let ((cur-time (current-time))
  295.       (newsrc (cdr gnus-newsrc-alist))
  296.       info group unread has-ticked)
  297.       (while (setq info (pop newsrc))
  298.     (setq group (gnus-info-group info)
  299.           unread (gnus-group-unread group)
  300.           has-ticked (cdr (assq 'tick (gnus-info-marks info))))
  301.     (when (and (numberp unread)
  302.            (= unread 0)
  303.            (not has-ticked))
  304.       (gnus-group-set-parameter group 'timestamp cur-time))))))
  305.  
  306. (provide 'gnus-demon)
  307.  
  308. ;;; gnus-demon.el ends here
  309.